package Bio::Tools::Mgip;

use base qw(Bio::Root::Root);
use File::Temp qw/ tempfile tempdir /;
use 5.008008;
use strict;
use warnings;
use Data::Dumper;

require Exporter;

our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.50';

sub new{
    my($class,$args)=@_;
    
    # construct the object
    # SOAP doesn't need to be defined yet because the soap subroutine defines it
    my $self={};
    # turn the object into this class
    bless($self,$class);
    return $self;
}
# log into MGIP, return a hash of user information
sub login{
    my($self,@args)=@_;
    my($username,$password)=$self->_rearrange( [qw(USERNAME PASSWORD)], @args);
    my($response,$value);
    $response=$self->soap->setupUser($username,$password);
    return $self->_soapValue($response);
}
# get MGIP user information
sub getInfo{
	my($self,@args)=@_;
	my($response,$value);
	$response=$self->soap->getInfo();
    return $self->_soapValue($response);
}
# is this user the public user (i.e. not logged in)?
sub is_public {
  my($self,@args)=@_;
  my($response,$value);
  $response=$self->soap->is_public();
  return $self->_soapValue($response);
}

sub searchAlignments {
  my($self,@args)=@_;
  my($search)=$self->_rearrange( [qw(SEARCH)], @args);
  my($response,$value);
  $response=$self->soap->searchAlignments($search);
  return $self->_soapValue($response);
}
# give an alignmentid for this
sub getTraces {
  my($self,@args)=@_;
  my($id)=$self->_rearrange( [qw(ID)], @args);
  my($response,$value);
  $response=$self->soap->getTraces($id);
  return $self->_soapValue($response);
}
# give a traceid
sub getTrace {
  my($self,@args)=@_;
  my($id)=$self->_rearrange( [qw(ID)], @args);
  my($response,$value);
  $response=$self->soap->getTrace($id);
  return $self->_soapValue($response);
}
# in $data, give it an array of binary data to send (64-bit encoded)
# Returns a huge hash of results
sub processBinaryTraces {
  my($self,@args)=@_;
  my($response,$value);
  my($locusid,$data)=$self->_rearrange( [qw(LOCUSID DATA)],@args);
  $response=$self->soap->processBinaryTraces($locusid,$data);
  return $self->_soapValue($response);
}


#int $setid: The alignment set id
#int $limit: The number of rows to skip before returning alignments
#int $num: The number of results to return
#int $deleted: 0 or 1: whether or not to return deleted results
sub getAlignments {
  my($self,@args)=@_;
  my($response,$value);
  my($setid,$limit,$num)=$self->_rearrange( [qw(SETID LIMIT NUM)],@args);
  $response=$self->soap->getAlignments($setid,$limit=0,$num=50);
  return $self->_soapValue($response);
}
# needs alignment id
sub getAlignment {
  my($self,@args)=@_;
  my($response,$value);
  my($alignmentid)=$self->_rearrange( [qw(ALIGNMENTID)],@args);
  $response=$self->soap->getAlignment($alignmentid);
  return $self->_soapValue($response);
}
sub getAllAlignments {
  my($self,@args)=@_;
  my($response,$value);
  $response=$self->soap->getAllAlignments();
  return $self->_soapValue($response);
}

#SET
sub searchSets {
  my($self,@args)=@_;
  my($response,$value);
  my($search)=$self->_rearrange( [qw(SEARCH)],@args);
  $response=$self->soap->searchSets($search);
  return $self->_soapValue($response);
}
sub getSet {
  my($self,@args)=@_;
  my($response,$value);
  my($id)=$self->_rearrange( [qw(ID)],@args);
  $response=$self->soap->getSet($id);
  return $self->_soapValue($response);
}
sub getSets {
  my($self,@args)=@_;
  my($response,$value);
  my($limit,$num,$deleted)=$self->_rearrange( [qw(LIMIT NUM DELETED)],@args);
  $response=$self->soap->getSets($limit,$num,$deleted);
  return $self->_soapValue($response);
}
sub updateSet {
  my($self,@args)=@_;
  my($response,$value);
  my($setid,$newName)=$self->_rearrange( [qw(SETID NEWNAME)],@args);
  $response=$self->soap->updateSet($setid,$newName);
  return $self->_soapValue($response);
}
sub getTotalNumSets {
  my($self,@args)=@_;
  my($response,$value);
  my($deleted)=$self->_rearrange( [qw(DELETED)],@args);
  $response=$self->soap->getTotalNumSets($deleted);
  return $self->_soapValue($response);
}
sub deleteSet {
  my($self,@args)=@_;
  my($response,$value);
  my($setid)=$self->_rearrange( [qw(SETID)],@args);
  $response=$self->soap->deleteSet($setid);
  return $self->_soapValue($response);
}


# ORGANISMS
sub getOrganisms{
    my($self,@args)=@_;
    my($response,$value);
    $response=$self->soap->getOrganisms();
    return $self->_soapValue($response);
}
# Changes the current organism, returns a boolean
# TODO return organism object
sub changeCurrentOrganism{
	my($self,@args)=@_;
    my($organismId)=$self->_rearrange( [qw(ORGANISMID)], @args);
    my($response,$value);
    $response=$self->soap->changeCurrentOrganism($organismId);
    return $self->_soapValue($response);
}
sub getCurrentOrganism {
  my($self,@args)=@_;
  my($response,$value);
  $response=$self->soap->getCurrentOrganism();
  return $self->_soapValue($response);
}


# LOCI
# return all loci.  Parameter: T/F: group into typing methods
sub getLoci{
    my($self,@args)=@_;
    my($group)=$self->_rearrange( [qw(GROUP)], @args);
    my($response,$value);
    $response=$self->soap->getLoci($group);
    return $self->_soapValue($response);
}
sub getLocus {
  my($self,@args)=@_;
  my($response,$value);
  my($locusid)=$self->_rearrange( [qw(LOCUSID)],@args);
  $response=$self->soap->getLocus($locusid);
  return $self->_soapValue($response);
}
sub deleteLocus {
  my($self,@args)=@_;
  my($response,$value);
  my($id)=$self->_rearrange( [qw(ID)],@args);
  $response=$self->soap->deleteLocus($id);
  return $self->_soapValue($response);
}
sub insertLocus {
  my($self,@args)=@_;
  my($response,$value);
  my($name,$typing,$length,$dbFile,$dbProtein,$sourceFormat)=$self->_rearrange( [qw(NAME TYPING LENGTH DBFILE DBPROTEIN SOURCEFORMAT)],@args);
  $response=$self->soap->insertLocus($name,$typing,$length,$dbFile,$dbProtein,$sourceFormat);
  return $self->_soapValue($response);
}
sub updateLocus {
  my($self,@args)=@_;
  my($response,$value);
  my($locusid)=$self->_rearrange( [qw(LOCUSID)],@args);
  $response=$self->soap->updateLocus($locusid);
  return $self->_soapValue($response);
}

#ST
sub getNumSt {
  my($self,@args)=@_;
  my($response,$value);
  $response=$self->soap->getNumSt();
  return $self->_soapValue($response);
}
sub getSt {
  my($self,@args)=@_;
  my($response,$value);
  my($ST)=$self->_rearrange( [qw(ST)],@args);
  $response=$self->soap->getSt($ST);
  return $self->_soapValue($response);
}
sub getStFromAllelesLoosely {
  my($self,@args)=@_;
  my($response,$value);
  my($alleleArray)=$self->_rearrange( [qw(ALLELEARRAY)],@args);
  $response=$self->soap->getStFromAllelesLoosely($alleleArray);
  return $self->_soapValue($response);
}
# allele array is really a hash
sub getStFromAlleles {
  my($self,@args)=@_;
  my($response,$value);
  my($alleleArray)=$self->_rearrange( [qw(ALLELEARRAY)],@args);
  $response=$self->soap->getStFromAlleles($alleleArray);
  return $self->_soapValue($response);
}
sub getSequenceTypingMethods {
  my($self,@args)=@_;
  my($response,$value);
  $response=$self->soap->getSequenceTypingMethods();
  return $self->_soapValue($response);
}


# PRIMERS
sub getPrimers {
  my($self,@args)=@_;
  my($response,$value);
  $response=$self->soap->getPrimers();
  return $self->_soapValue($response);
}
sub getPrimer {
  my($self,@args)=@_;
  my($response,$value);
  my($primerid)=$self->_rearrange( [qw(PRIMERID)],@args);
  $response=$self->soap->getPrimer($primerid);
  return $self->_soapValue($response);
}


# UTILITY METHODS
# Change -m 8 or -m 9 output of blast to an array of hashes
sub processBlast {
  my($self,@args)=@_;
  my($response,$value);
  my($blastResult)=$self->_rearrange( [qw(BLASTRESULT)],@args);
  $response=$self->soap->processBlast($blastResult);
  return $self->_soapValue($response);
}
# Get the soap object but make it first if it doesn't exist yet
sub soap{
  my($self,@args)=@_;
  # if it's not defined, then make it and set it
  if(!defined $self->{SOAP}){
    $self->{SOAP}=$self->_mgipSoap;
  }
  return $self->{SOAP};
}

#########
# private functions
#############

# return a defereferenced soap value
# Also check for an error
sub _soapValue{
  my($self,$response)=@_;
  if(!$self->_checkSoapError($response)){
    return 0;
  }
  # return the appropriate type
  my $value=$response->result;
  my $type=ref($value);
  if(!$type){
  	return $value;
  }
  elsif($type eq "HASH"){
  	return %$value;
  }
  elsif($type eq "ARRAY"){
  	return @$value;
  }
  elsif($type eq "SCALAR"){
  	return $value;
  }
  
  # something is wrong if the value isn't returned yet.
  $self->throw("The SOAP response was not a recognized type (hash, array, scalar). Printing Dumper: ".Dumper($value));
  return 0;
}

# check for any errors in the soap response. Return 0 on error
# TODO return number of results or scalar of the value
sub _checkSoapError{
  my($self,$response)=@_;
  if($response->faultstring){
  	$self->throw($response->faultstring);
  	return 0;
  }
  return 1;
}
# make a soap object for MGIP
sub _mgipSoap{
  use SOAP::Lite;
  my($cookieFh,$cookieFile,$cookie,$mgipSoap);
  
  # cookie
  ($cookieFh,$cookieFile)=tempfile('MGIPcookie_XXXX',UNLINK=>1);
  $cookie=HTTP::Cookies->new(ignore_discard=>1,file=>$cookieFh,autosave=>1);
  
  $mgipSoap = SOAP::Lite
    -> uri('MGIP')
    -> proxy('http://mgip2.biology.gatech.edu/api/apiServer.php');
  $mgipSoap->transport->cookie_jar($cookie);
  return $mgipSoap;
}

1;